home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / DIRS.SWG / 0036_Create Directories.pas < prev    next >
Pascal/Delphi Source File  |  1994-08-25  |  2KB  |  58 lines
  1. {
  2. >Has anyone written a function for creating a pathname ?
  3. >I'm having a problem with putting together a function that you
  4. >can pass a pathname to, such as: C:\WINDOWS\SYSTEM\STUFF
  5. >and have it create the path if it's at all possible.
  6. >the problem I'm having seems to stem from the fact that 'MKDIR()'
  7. >can only handle making one directory which is under the current one.
  8.  
  9.  This is because DOS' MkDir itself will fail if any element of a
  10.  path is missing.  You'll need to parse and build the path, going
  11.  directory by directory.
  12.  
  13.  Here's some example code that you may use to create a MakePath
  14.  function...
  15. }
  16.  
  17. PROGRAM MakePath;     { Create a path.  July 21,1994  Greg Vigneault  }
  18.  
  19. VAR   Try, Slash  : BYTE;
  20.       Error       : WORD;
  21.       TmpDir, IncDir, NewDir, OurDir : STRING;
  22. BEGIN
  23.   WriteLn;
  24.  
  25.   NewDir := 'C:\000\111\222'; { an example path to create }
  26.  
  27.   GetDir (0,OurDir); { because we'll use CHDIR to confirm directories }
  28.   WHILE NewDir[Length(NewDir)] = '\' DO DEC(NewDir[0]); { clip '\' }
  29.   IncDir := ''; { start with empty string }
  30.   REPEAT
  31.     Slash := Pos('\',NewDir); { check for slash }
  32.     IF (Slash <> 0) THEN BEGIN
  33.       IncDir := IncDir + Copy( NewDir, 1, Slash ); { get directory }
  34.       NewDir := Copy( NewDir, Slash+1, Length(NewDir)-Slash ); END
  35.     ELSE
  36.       IncDir := IncDir + NewDir;
  37.     TmpDir := IncDir;
  38.     IF (Length(TmpDir) > 3) THEN { clip any trailing '\' }
  39.       WHILE TmpDir[Length(TmpDir)] = '\' DO DEC(TmpDir[0]);
  40.     REPEAT
  41.       {$I-} ChDir(TmpDir); {$I+} { try to log into the directory... }
  42.       Error := IoResult;
  43.       IF (Error <> 0) THEN BEGIN { couldn't ChDir, so try MkDir... }
  44.         {$I-} MkDir(TmpDir); {$I+}
  45.         Error := IoResult;
  46.       END;
  47.       IF (Error <> 0) THEN INC(Try) ELSE Try := 0;
  48.     UNTIL (Error = 0) OR (Try > 3);
  49.     IF (Error = 0) THEN WriteLn('"',TmpDir,'" -- okay');
  50.   UNTIL (Slash = 0) OR (Error <> 0);
  51.  
  52.   IF (Error <> 0) THEN WriteLn('MkDir ',TmpDir,' failed!',#7);
  53.  
  54.   ChDir(OurDir);  { log back into our starting directory }
  55.  
  56.   WriteLn;
  57. END {MakePath}.
  58.